home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Environments
/
PowerMacOberon feb96
/
Source
/
Backup.Mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1995-09-18
|
13KB
|
344 lines
Syntax10.Scn.Fnt
FoldElems
Syntax10.Scn.Fnt
(* ----------------------------------------------------------
Backup does an incremental backup between two directories, i.e. only the files that
have changed since the last backup are copied.
Backup.WriteFiles ( {src dst} ~ | "^")
src and dst are given as Macintosh path names starting with the volume name
and ending with ":". If a path name contains blanks it must be written under quotes.
All entries in dst which are not also in src are deleted so that after the backup
the contents of dst will be equal to the contents of src.
Example:
Backup.WriteFiles Othello:Text:Lectures:EiP: hm:Backup:EiP: ~
----------------------------------------------------------*)
Syntax10i.Scn.Fnt
StampElems
Alloc
18 Sep 95
Syntax10.Scn.Fnt
VAR i: INTEGER;
BEGIN
i := 0; WHILE in[i] # 0X DO out[i+1] := in[i]; INC(i) END;
out[0] := CHR(i)
END MakeStr255;
Syntax10.Scn.Fnt
VAR res: INTEGER;
BEGIN
NEW(par);
par.ioCompletion := 0; par.ioNamePtr := SYSTEM.ADR(spec.name);
par.ioVRefNum := spec.vRefNum; par.ioDirID := spec.parID; par.ioFDirIndex := 0;
res := Sys.PBGetCatInfo(par); ASSERT(res = 0)
END GetFileInfo;
Syntax10.Scn.Fnt
VAR res: INTEGER;
BEGIN
NEW(par);
par.ioCompletion := 0; par.ioNamePtr := SYSTEM.ADR(spec.name);
par.ioVRefNum := spec.vRefNum; par.ioDrDirID := spec.parID; par.ioFDirIndex := 0;
res := Sys.PBGetCatInfo(par); ASSERT(res = 0)
END GetDirInfo;
Syntax10.Scn.Fnt
VAR ch, start: CHAR; i: INTEGER;
BEGIN
REPEAT In.Char(ch) UNTIL (ch > " ") OR ~In.Done;
i := 1;
IF (ch = '"') OR (ch = "'") THEN
start := ch; In.Char(ch);
WHILE In.Done & (ch # start) DO s[i] := ch; INC(i); In.Char(ch) END;
In.Char(ch);
ELSE
WHILE In.Done & (ch > " ") DO s[i] := ch; INC(i); In.Char(ch) END
END;
s[i] := 0X; s[0] := CHR(i-1);
FOR i := 1 TO ORD(s[0]) DO
IF (s[i] >= CHR(129)) & (s[i] <= CHR(133)) THEN s[i] := umlaut[ORD(s[i])-129] END
END ReadString;
Syntax10.Scn.Fnt
VAR i, j: INTEGER;
BEGIN
FOR i := 1 TO ORD(s[0]) DO
FOR j := 0 TO LEN(umlaut)-1 DO
IF s[i] = umlaut[j] THEN s[i] := CHR(129 + j) END
END
END;
s[0] := " "; s[i] := 0X; Out.String(s)
END PrintString;
Syntax10.Scn.Fnt
VAR i: INTEGER;
BEGIN
IF a[0] # b[0] THEN RETURN FALSE END;
i := ORD(a[0]); WHILE (i > 0) & (a[i] = b[i]) DO DEC(i) END;
RETURN i = 0
END EqualString;
Syntax10.Scn.Fnt
BEGIN
Out.String(" --- ");
CASE n OF
-33: Out.String("directory full")
| -34: Out.String("disk full")
| -35: Out.String("volume not found")
| -37: Out.String("bad file or volume name")
| -43: Out.String("file not found")
| -44, -46: Out.String("volume locked")
| -45: Out.String("file locked")
| -47: Out.String("file busy or directory not empty")
| -49: Out.String("file already open for writing")
ELSE Out.F("error #", n)
END;
Out.Ln
END Err;
Syntax10.Scn.Fnt
VAR f: File;
BEGIN
NEW(f); f.next := NIL; f.spec := spec; f.touched := FALSE;
f.date := info.ioFlMdDat; f.len := info.ioFlLgLen; f.rlen := info.ioFlRLgLen;
f.creator := info.ioFlFndrInfo.fdCreator; f.type := info.ioFlFndrInfo.fdType;
IF f.len > maxLen THEN maxLen := f.len END;
IF f.rlen > maxLen THEN maxLen := f.rlen END;
RETURN f
END NewFile;
Syntax10.Scn.Fnt
VAR g: File;
BEGIN
g := d.files;
WHILE (g # NIL) & ~EqualString(f.spec.name, g.spec.name) DO g := g.next END;
RETURN g
END ThisFile;
Syntax10.Scn.Fnt
FoldElems
Syntax10.Scn.Fnt
PrintString(f.spec.name);
IF g # NIL THEN
res := Sys.FSpDelete(g.spec); ASSERT(res = 0, 99)
ELSE
NEW(g);
FOR i := 0 TO ORD(f.spec.name[0]) DO s[i] := f.spec.name[i] END;
res := Sys.FSMakeFSSpec(dt.spec.vRefNum, dt.dirID, s, g.spec); ASSERT(res = fnfErr, 98)
END;
res := Sys.FSpCreate(g.spec, f.creator, f.type, Sys.smSystemScript); IF res # 0 THEN Err(res); RETURN END;
Syntax10i.Scn.Fnt
Syntax10.Scn.Fnt
res := Sys.FSpOpenDF(f.spec, 0, fRef); IF res # 0 THEN Err(res); RETURN END;
res := Sys.FSpOpenDF(g.spec, 0, gRef); IF res # 0 THEN Err(res); RETURN END;
res := Sys.FSRead(fRef, f.len, SYSTEM.ADR(buf^)); ASSERT(res = 0, 94);
res := Sys.FSWrite(gRef, f.len, SYSTEM.ADR(buf^)); IF res # 0 THEN Err(res) END;
res := Sys.FSClose(fRef); ASSERT(res = 0, 92);
res := Sys.FSClose(gRef); ASSERT(res = 0, 91);
Syntax10.Scn.Fnt
IF f.rlen > 0 THEN
res := Sys.FSpOpenRF(f.spec, 0, fRef); IF res # 0 THEN Err(res); RETURN END;
res := Sys.FSpOpenRF(g.spec, 0, gRef); IF res # 0 THEN Err(res); RETURN END;
res := Sys.FSRead(fRef, f.rlen, SYSTEM.ADR(buf^)); ASSERT(res = 0, 88);
res := Sys.FSWrite(gRef, f.rlen, SYSTEM.ADR(buf^)); IF res # 0 THEN Err(res) END;
res := Sys.FSClose(fRef); ASSERT(res = 0, 86);
res := Sys.FSClose(gRef); ASSERT(res = 0, 85);
Out.String(" + resources")
END;
VAR res, i: INTEGER; s: Sys.Str255; fRef, gRef: INTEGER; info: FileInfo;
BEGIN
create empty g on dt
copy data fork
copy resource fork
Out.String(" saved$"); INC(savedFiles)
END SaveFile;
Syntax10.Scn.Fnt
VAR d: Directory; info: DirInfo; res: INTEGER;
BEGIN
NEW(d); d.next := NIL; d.files := NIL; d.dirs := NIL;
d.spec := spec;
GetDirInfo(spec, info); d.dirID := info.ioDrDirID; d.date := info.ioDrMdDat;
RETURN d
END NewDir;
Syntax10.Scn.Fnt
VAR spec: Sys.FSSpec; s: Sys.Str255; res, i: INTEGER; dummy: LONGINT;
BEGIN
FOR i := 0 TO ORD(df.spec.name[0]) DO s[i] := df.spec.name[i] END;
res := Sys.FSMakeFSSpec(parent.spec.vRefNum, parent.dirID, s, spec); ASSERT(res = fnfErr, 29);
res := Sys.FSpDirCreate(spec, Sys.smSystemScript, dummy); ASSERT(res = 0, 30);
dt := NewDir(spec)
END CreateDir;
Syntax10.Scn.Fnt
VAR g: File;
BEGIN
g := d.dirs;
WHILE (g # NIL) & ~EqualString(f.spec.name, g.spec.name) DO g := g.next END;
RETURN g
END ThisDir;
Syntax10.Scn.Fnt
VAR f: File; i: INTEGER;
BEGIN
FOR i := 1 TO indent DO Out.String(" ") END;
Out.String("--- "); PrintString(d.spec.name); Out.Ln;
f := d.files;
WHILE f # NIL DO
FOR i := 1 TO indent DO Out.String(" ") END;
Out.String(" "); PrintString(f.spec.name); Out.Ln;
f := f.next
END;
f := d.dirs;
WHILE f # NIL DO PrintDir(f(Directory), indent + 1); f := f.next END
END PrintDir;
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
VAR f: File; d1: Directory; par: FileInfo; res, n, i: INTEGER; spec: Sys.FSSpec; s: Sys.Str255;
BEGIN
n := 1; Out.Char(prompt);
NEW(par); par.ioCompletion := 0; par.ioVRefNum := d.spec.vRefNum;
LOOP
s[0] := 0X; par.ioNamePtr := SYSTEM.ADR(s);
par.ioDirID := d.dirID;
par.ioFDirIndex := n; INC(n);
res := Sys.PBGetCatInfo(par);
IF res = 0 THEN
IF par.ioFlFndrInfo.fdFlags >= 0 THEN (*no alias: alias files have bit 15 set*)
res := Sys.FSMakeFSSpec(d.spec.vRefNum, d.dirID, s, spec); ASSERT(res = 0);
IF ODD(par.ioFlAttrib DIV 16) THEN (*directory*)
d1 := NewDir(spec); d1.next := d.dirs; d.dirs := d1
ELSE (*file*)
f := NewFile(spec, par); f.next := d.files; d.files := f
END
END
ELSIF res = fnfErr THEN EXIT
ELSE HALT(20)
END
END;
f := d.dirs;
WHILE f # NIL DO FillDir(f(Directory), prompt); f := f.next END
END FillDir;
Syntax10.Scn.Fnt
VAR f, g: File; first: BOOLEAN;
BEGIN
f := df.files; first := TRUE;
WHILE f # NIL DO
g := ThisFile(dt, f);
IF (g = NIL) OR (f.date > g.date) THEN
IF first THEN Out.String("-- "); PrintString(df.spec.name); Out.Ln; first := FALSE END;
SaveFile(f, g, dt)
END;
g.touched := TRUE;
f := f.next
END;
f := df.dirs;
WHILE f # NIL DO
g := ThisDir(dt, f);
IF g = NIL THEN CreateDir(f(Directory), dt, g) END;
SaveDir(f(Directory), g(Directory));
g.touched := TRUE;
f := f.next
END SaveDir;
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
VAR f: File; first: BOOLEAN; res: INTEGER; inf: DirInfo;
BEGIN (*delete redundant files in d*)
f := d.files; first := TRUE;
WHILE f # NIL DO
IF ~f.touched THEN
IF first THEN Out.String("-- "); PrintString(d.spec.name); Out.Ln; first := FALSE END;
res := Sys.FSpDelete(f.spec);
PrintString(f.spec.name); Out.String(" deleted$")
END;
f := f.next
END;
f := d.dirs;
WHILE f # NIL DO
CleanupDir(f(Directory));
res := Sys.FSpDelete(f.spec);
IF res = 0 THEN (*was empty*)
IF first THEN Out.String("-- "); PrintString(d.spec.name); Out.Ln; first := FALSE END;
PrintString(f.spec.name); Out.String(" deleted$")
END;
f := f.next
END CleanupDir;
Syntax10b.Scn.Fnt
Syntax10.Scn.Fnt
VAR path: Sys.Str255; df, dt: Directory; res: INTEGER; spec: Sys.FSSpec;
BEGIN
In.Open; Out.Open; savedFiles := 0;
LOOP
ReadString(path);
IF (path[0] = 0X) OR (path[1] = "~") THEN EXIT END;
res := Sys.FSMakeFSSpec(0, 0, path, spec);
IF res # 0 THEN Out.F("-- Invalid source directory. res = #$", res); EXIT END;
df := NewDir(spec);
ReadString(path);
res := Sys.FSMakeFSSpec(0, 0, path, spec);
IF res # 0 THEN Out.F("-- Invalid destination directory. res = #$", res); EXIT END;
dt := NewDir(spec);
maxLen := 0;
Out.String("Reading directories");
FillDir(df, "-"); FillDir(dt, "+");
Out.Ln;
NEW(buf, maxLen);
(*PrintDir(df, 0); PrintDir(dt, 0);*)
SaveDir(df, dt);
CleanupDir(dt)
END;
Out.F("$# files saved$", savedFiles);
Out.Close; buf := NIL
END WriteFiles;
Documentation
MODULE Backup; (* HM
IMPORT Sys, In, Out, SYSTEM;
CONST
fnfErr = -43;
File = POINTER TO FileDesc;
FileDesc = RECORD
next: File;
spec: Sys.FSSpec;
date, len, rlen, creator, type: LONGINT;
touched: BOOLEAN
END;
Directory = POINTER TO DirectoryDesc;
DirectoryDesc = RECORD (FileDesc)
dirID: LONGINT;
files: File; (*the files in this directory*)
dirs: File (*the subdirectories in this directory*)
END;
DirInfo = POINTER TO DirInfoDesc;
DirInfoDesc = RECORD (Sys.CInfoPBRec)
ioDrUsrWds: Sys.DInfo;
ioDrDirID: LONGINT;
ioDrNmFls: INTEGER;
f3: ARRAY 9 OF INTEGER;
ioDrCrDat: LONGINT;
ioDrMdDat: LONGINT;
ioDrBkDat: LONGINT;
ioDrFndrInfo: Sys.DXInfo;
ioDrParID: LONGINT
END;
FileInfo = Sys.CInfoPBFilePtr;
maxLen: LONGINT; (*max. file length (determines buffer sizes)*)
buf: POINTER TO ARRAY OF CHAR; (*files are copied via this buffer*)
savedFiles: LONGINT; (*number of saved files*)
umlaut: ARRAY 5 OF CHAR; (*conversion of Oberon umlauts to Mac umlauts*)
(*--- toolbox*)
PROCEDURE MakeStr255 (VAR in: ARRAY OF CHAR; VAR out: Sys.Str255);
PROCEDURE GetFileInfo (spec: Sys.FSSpec; VAR par: FileInfo);
PROCEDURE GetDirInfo (spec: Sys.FSSpec; VAR par: DirInfo);
(*--- auxiliaries*)
PROCEDURE ReadString (VAR s: ARRAY OF CHAR);
PROCEDURE PrintString (s: ARRAY OF CHAR);
PROCEDURE EqualString (a, b: ARRAY OF CHAR): BOOLEAN;
PROCEDURE Err (n: INTEGER);
(*--- files*)
PROCEDURE NewFile (spec: Sys.FSSpec; info: FileInfo): File;
PROCEDURE ThisFile (d: Directory; f: File): File;
PROCEDURE SaveFile (f: File; VAR g: File; dt: Directory);
(*--- directories*)
PROCEDURE NewDir (spec: Sys.FSSpec): Directory;
PROCEDURE CreateDir (df, parent: Directory; VAR dt: File);
PROCEDURE ThisDir (d: Directory; f: File): File;
(*PROCEDURE PrintDir (d: Directory; indent: INTEGER);
PROCEDURE FillDir (d: Directory; prompt: CHAR);
PROCEDURE SaveDir (df, dt: Directory);
PROCEDURE CleanupDir (d: Directory);
PROCEDURE WriteFiles*;
BEGIN
umlaut[0] := CHR(133); (*Oe*)
umlaut[1] := CHR(134); (*Ue*)
umlaut[2] := CHR(138); (*ae*)
umlaut[3] := CHR(154); (*oe*)
umlaut[4] := CHR(159); (*ue*)
END Backup.